home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 January / macformat-020.iso / Shareware City / Education / RLaB / rlib / printmat.r < prev    next >
Encoding:
Text File  |  1994-07-16  |  2.8 KB  |  136 lines  |  [TEXT/ttxt]
  1. //--------------------------------------------------------------------------------
  2. // printmat
  3.  
  4. // Synopsis: Print a matrix with title and labels.
  5.  
  6. // Syntax: printmat(a,anme,rlab,clab);
  7.  
  8. // Description:
  9.  
  10. // This routine prints the matrix a using the title contained in the
  11. // string name and the row labels contained in rowlab and the
  12. // column labels contained in collab. Note: rowlab and collab are
  13. // vectors of strings, such as
  14. //
  15. //         rowlab[1]="alpha";
  16. //         rowlab[2]="beta";
  17. //         rowlab[3]="gamma";
  18. //
  19. //  Note: name, rowlab, and collab are optional variables.
  20. //
  21. //--------------------------------------------------------------------------------
  22.  
  23. printmat = function (a, mname, rowlab, collab, fn)
  24. {
  25.   local(nrows,ncols,col_per_scrn,len,col,n,icol,nmax,...
  26.         i,j,k,sdum,element,ishift,narg, rl, cl, s, tmp)
  27.  
  28.   narg=0;
  29.   if (!exist (a)) { error ("printmat: must supply a matrix"); }
  30.   if (!exist (mname)) { mname = ""; }
  31.   if (!exist (rowlab)) { rl = []; else rl = rowlab; }
  32.   if (!exist (collab)) { cl = []; else cl = collab; }
  33.   if (!exist (fn))     { fn = "stdout"; }
  34.   
  35.   nrows=a.nr;
  36.   ncols=a.nc;
  37.   
  38.   // Create row and column labels if necessary
  39.   if (rl.n == 0)
  40.   {
  41.     for (i in 1:nrows) 
  42.     {
  43.       sprintf (tmp, "%3i", i);
  44.       rl[i]="--"+ tmp +" --> ";
  45.     }
  46.   }
  47.   if (cl.n == 0)
  48.   {   
  49.     for (i in 1:ncols) { cl[i]="----"+int2str(i)+"---- "; }
  50.   }
  51.   
  52.   col_per_scrn=5;
  53.   len=12;
  54.   
  55.   if ((nrows==0)||(ncols==0)) 
  56.   { 
  57.     if (length (mname)) 
  58.     {
  59.       fprintf(fn," \n%s = \n \n",mname);
  60.       return 0;
  61.     }
  62.     fprintf(fn," \n%s \n","     [] \n");
  63.     return 0;
  64.   }
  65.  
  66.  
  67.   // Print matrix name
  68.   col=1;
  69.   n = min([col_per_scrn-1,ncols-1]);
  70.   if (length (mname)) 
  71.   {
  72.     fprintf(fn,"\n%s = \n \n",mname);
  73.   }
  74.  
  75.   // Print column labels
  76.   s="";
  77.   icol=0;
  78.   while (col <= ncols) 
  79.   {
  80.     icol=icol+1;
  81.     s="            ";
  82.     for (j in 0:n) 
  83.     {
  84.       ishift=12-length(cl[j+col]);
  85.       for (k in 1:ishift) 
  86.       {
  87.     s=s+" ";
  88.       }
  89.       s=s+cl[j+col];
  90.     }
  91.     fprintf(fn,"%s\n",s);
  92.     
  93.     // Print Row Labels
  94.     for (i in 1:nrows) 
  95.     {
  96.       s=""+rl[i];
  97.       ishift=12-length(rl[i]);
  98.       for (k in 1:ishift) 
  99.       {
  100.     s=s+" ";
  101.       }
  102.       for (j in 0:n) 
  103.       {
  104.     element = a[i;col+j];
  105.     if (element == 0) {
  106.       s=s+"           0";
  107.     else if (element >= 1.0e+06) {
  108.       sdum="";
  109.       sprintf(sdum,"%12.5e",element);
  110.       s=s+sdum;
  111.     else if (element <= -1.0e+05) {
  112.       sdum="";
  113.       sprintf(sdum,"%12.5e",element);
  114.       s=s+sdum;
  115.     else if (abs(element) < 0.0001) {
  116.       sdum="";
  117.       sprintf(sdum,"%12.5e",element);
  118.       s=s+sdum;
  119.     else
  120.       sdum="";
  121.       sprintf(sdum,"%12.5f",element);
  122.       s=s+sdum;
  123.         } } } }
  124.       }
  125.       fprintf(fn,"%s\n",s);
  126.     }
  127.     col = col+col_per_scrn;
  128.     fprintf(fn,"%s"," \n");
  129.     if ((ncols-col) < n) 
  130.     {
  131.       n=ncols-col;
  132.     }
  133.   }
  134.   return 0;  
  135. };
  136.